home *** CD-ROM | disk | FTP | other *** search
/ ETO Development Tools 1 / ETO Development Tools 1.iso / Essentials / Developer Essentials Jul 90 / Apple II / Programming & Utilities / Apple IIgs APW Intro Prog Src / HP.PAS / FONT.PAS.txt < prev    next >
Encoding:
Text File  |  1987-09-13  |  5.5 KB  |  174 lines
  1. UNIT Font;
  2.  
  3. {+----------------------------------------------------------------------------+
  4.  |                                                                            |
  5.  |         HodgePodge:  An example Apple IIGS Desktop application             |
  6.  |                                                                            |
  7.  |    Written in 65816 assembler and APW C by the Apple IIGS Tools Team       |
  8.  |              Translated to TML Pascal by TML Systems, Inc.                 |
  9.  |  Modified by Ben Koning for "Programmer's Introduction to the Apple IIGS"  |
  10.  |                                                                            |
  11.  |             Copyright (c) 1986-87 by Apple Computer, Inc.                  |
  12.  |                Copyright (c) 1987 by TML Systems, Inc.                     |
  13.  |                                                                            |
  14.  |                     --------------------------------                       |
  15.  |                                                                            |
  16.  |        Pascal UNIT "FONT.PAS" : Font window drawing routines               |
  17.  |                                                                            |
  18.  +----------------------------------------------------------------------------+}
  19.  
  20.  
  21.  
  22. INTERFACE
  23.  
  24. USES
  25.        HPIntfData,         {HodgePodge Apple IIGS Toolbox Interface Units}
  26.        HPIntfProc,
  27.        HPIntfPdos,
  28.  
  29.        Globals;            {HodgePodge Code Unit}
  30.  
  31.  
  32.  
  33. procedure DispFontWindow;                  {Draw font window contents        }
  34. function  DoChooseFont: boolean;           {Dialog for asking font size, etc.}
  35. procedure DoSetMono;                       {Sets flag and affects menu item  }
  36. procedure ShowFont (theFontID: FontID; isMono: boolean);  {Actually draw font}
  37.  
  38.  
  39.  
  40.  
  41.  
  42. IMPLEMENTATION
  43.  
  44.  
  45.  
  46. procedure DispFontWindow;
  47.  
  48.    {This is a Definition Procedure used to draw the contents of a Font
  49.     window.}
  50.  
  51.    var tmpPort      : GrafPortPtr;
  52.        myDataHandle : WindDataH;
  53.  
  54.    begin   {of DispFontWindow}
  55.        tmpPort      := GetPort;
  56.        myDataHandle := WindDataH (GetWRefCon (tmpPort));
  57.        with myDataHandle^^ do
  58.            ShowFont (theFont,isMono);
  59.    end;    {of DispFontWindow}
  60.  
  61.  
  62.  
  63. function DoChooseFont: boolean;
  64.  
  65.  {Display the Font Manager's dialog for the user to select a Font,
  66.   font size, and font style.
  67.  
  68.   The function returns true if a font was chosen, else false if the Cancel
  69.   button is pressed in the dialog.  If a font is chosen, its FontID information
  70.   is returned in the global variable DesiredFont.  In addition, the 
  71.   global myReply.filename contains a string which is the font's file name.
  72.  
  73.   Because the call to ChooseFont actually changes the font of the current
  74.   port, we must first save the current port and open a dummy one do that
  75.   our current port is not affected.}
  76.  
  77.    var theFont     :    FontID;
  78.        dummy       :    integer;
  79.        tmpPort     :    GrafPortPtr;
  80.        tmpPortRec  :    GrafPort;
  81.        famName     :    Str255;
  82.  
  83.    begin   {of DoChooseFont}
  84.        tmpPort := GetPort;
  85.        OpenPort (@tmpPortRec);             {Save current port and open new one}
  86.    
  87.        theFont := ChooseFont (DesiredFont,0);  {Do standard dialog box}
  88.  
  89.        if longint (theFont) = 0 then       {Cancel was chosen}
  90.            DoChooseFont := false
  91.        else begin
  92.            DesiredFont := theFont;         {Update global DesiredFont}
  93.            dummy := GetFamInfo (DesiredFont.famNum,famName);
  94.            myReply.filename := 
  95.                concat (famName,
  96.                        ' ',
  97.                        IntToString (DesiredFont.fontSize));
  98.            DoChooseFont := true;
  99.        end;
  100.  
  101.        ClosePort (@tmpPortRec);
  102.        SetPort (tmpPort);                   {Restore current port}
  103.  
  104.    end;    {of DoChooseFont}
  105.  
  106.  
  107.  
  108. procedure DoSetMono;
  109.  
  110.    {This procedure flips the flag indicating whether we are currently
  111.     displaying a font in mono-spacing or not, and updates the 
  112.     font menu item accordingly.}
  113.  
  114.    begin   {of DoSetMono}
  115.        if isMonoFont then
  116.            SetMItem (MonoStr,MonoItem)
  117.        else
  118.            SetMItem (ProStr,MonoItem);
  119.        isMonoFont := not isMonoFont;
  120.    end;    {of DoSetMono}
  121.  
  122.  
  123.  
  124. procedure ShowFont (theFontID: FontID; isMono: boolean);
  125.  
  126.    var FontInfo   : FontInfoRecord;
  127.        CurrHeight : integer;
  128.        i,j        : integer;
  129.        theCh      : integer;
  130.        currPt     : Point;
  131.        fontStr    : Str255;
  132.  
  133.    begin   {of ShowFont}
  134.        InstallFont (theFontID,0);
  135.        GetFontInfo (FontInfo);
  136.        CurrHeight := FontInfo.ascent + FontInfo.descent + FontInfo.leading;
  137.  
  138.        i := GetFamInfo (theFontID.famNum,fontStr);
  139.        fontStr := concat (fontStr,' ',IntToString (theFontID.fontSize));
  140.  
  141.        i := GetFontFlags;
  142.        if isMono then
  143.            i := BitOr  (i,$0001)           {Set bottom bit}
  144.        else
  145.            i := BitAnd (i,$0000);          {Clear bottom bit}
  146.        SetFontFlags(i);
  147.    
  148.        MoveTo     (5,CurrHeight);
  149.        DrawString (fontStr);
  150.    
  151.        MoveTo     (5,CurrHeight * 3);
  152.        DrawString ('The quick brown fox jumps over the lazy dog.');
  153.        MoveTo     (5,CurrHeight * 4);
  154.        DrawString ('She sells sea shells down by the sea shore.');
  155.  
  156.        MoveTo     (5,CurrHeight * 5);
  157.  
  158.        for i := 0 to 7 do begin
  159.            GetPen (currPt);
  160.            MoveTo (5,currPt.v + CurrHeight);
  161.            theCh := i * 32;
  162.            for j := 1 to 32 do begin
  163.                fontStr [j] := chr (theCh);
  164.                inc (theCh);
  165.            end;
  166.            fontStr [0] := chr (32);
  167.            DrawString (fontStr);
  168.        end;
  169.    end;    {of ShowFont}
  170.  
  171.  
  172.  
  173. END.
  174.